home *** CD-ROM | disk | FTP | other *** search
/ NetGuide 2004 March / NETGUIDN0403.iso / pc / featured / Windows / MediaMonkey_Setup_2_1.exe / {app} / Scripts / Export.vbs next >
Encoding:
Text File  |  2003-10-17  |  15.0 KB  |  526 lines
  1. ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  2. ' This file can be replaced  in one of the future versions,
  3. ' so please if you want to modify it, make  a copy, do your
  4. ' modifications  in that copy and  change Scripts.ini  file 
  5. ' appropriately. 
  6. ' If you do not do this, you will loose all your changes in
  7. ' this script when you install a new version of MediaMonkey
  8. ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  9.  
  10. Option Explicit     ' report undefined variables, ...
  11.  
  12. ' function for quoting strings
  13. Function QStr( astr)
  14.   QStr = chr(34) & astr & chr(34)
  15. End Function
  16.  
  17. Dim list      ' list of songs to be exported
  18. Dim res       ' results of dialogs calls
  19. Dim fullfile  ' fully specified output file name
  20. Dim fso       ' FileSystemObject
  21.  
  22. ' SDB variable is connected to MediaMonkey application object
  23.  
  24. Sub InitExport( ext, filter, iniDirValue)
  25.   fullfile = ""
  26.  
  27.   ' Get a list of songs to be exported
  28.   Set list = SDB.SelectedSongList
  29.   If list.count=0 Then
  30.     Set list = SDB.AllVisibleSongList
  31.   End If
  32.  
  33.   If list.count=0 Then
  34.     res = SDB.MessageBox( "Select tracks to be exported, please.", mtError, Array(mbOk))
  35.     Exit Sub
  36.   End If
  37.  
  38.   ' Open inifile and get last used directory
  39.   Dim iniF
  40.   Set iniF = SDB.IniFile
  41.  
  42.   ' Create common dialog and ask where to save the file
  43.   Dim dlg
  44.   Set dlg = SDB.CommonDialog
  45.   dlg.DefaultExt=ext
  46.   dlg.Filter=filter
  47.   dlg.Flags=cdlOFNOverwritePrompt + cdlOFNHideReadOnly
  48.   dlg.InitDir = iniF.StringValue( "Scripts", iniDirValue)
  49.   dlg.ShowSave
  50.  
  51.   if Not dlg.Ok Then
  52.     Exit Sub   ' if cancel was pressed, exit
  53.   End If
  54.  
  55.   ' Get the selected filename
  56.   fullfile = dlg.FileName
  57.  
  58.   ' Connect to the FileSystemObject
  59.   Set fso = CreateObject("Scripting.FileSystemObject")
  60.  
  61.   ' Write selected directory to the ini file
  62.   iniF.StringValue( "Scripts", iniDirValue) = fullfile
  63. End Sub
  64.  
  65. Sub FinishExport( ok)
  66.   On Error Resume Next
  67.  
  68.   ' remove the output file if terminated
  69.   if not Ok then
  70.     fso.DeleteFile( fullfile)
  71.   end if
  72.  
  73.   ' Notify user that it was successful
  74.   if ok then
  75.     res = SDB.MessageBox( "Export was completed successfully.", mtInformation, Array(mbOk))
  76.   else
  77.     res = SDB.MessageBox( "Export was terminated.", mtInformation, Array(mbOk))
  78.   end if
  79. End Sub
  80.  
  81. Sub ExportCSV
  82.   ' initialize export
  83.   Call InitExport (".csv", "CSV (*.csv)|*.csv|All files (*.*)|*.*", _
  84.       "LastExportCSVDir")
  85.   if fullfile="" then
  86.     Exit Sub
  87.   end if
  88.  
  89.   ' Create the output file
  90.   Dim fout
  91.   Set fout = fso.CreateTextFile( fullfile, True)
  92.  
  93.   ' Write header line
  94.   fout.WriteLine Join(Array("Artist","Song","Album","Time","Year","Genre","Rating","Bitrate","Path","Media"),",")
  95.  
  96.   ' Use progress to notify user about the current action
  97.   Dim Progress
  98.   Set Progress = SDB.Progress
  99.   Progress.Text = "Exporting to a CSV file..."
  100.  
  101.   ' Iterate through the list and export all songs
  102.   Progress.MaxValue = list.count
  103.   Dim i, itm
  104.   for i=0 to list.count-1
  105.     Set itm = list.Item(i)
  106.     Dim bitrate
  107.     bitrate = itm.bitrate
  108.     if bitrate>0 then
  109.       bitrate = CStr(Round( bitrate/1000))
  110.     else
  111.       bitrate = ""
  112.     end if
  113.     fout.WriteLine Join( Array( QStr(itm.ArtistName), QStr(itm.title), QStr(itm.AlbumName), _
  114.       QStr(itm.SongLengthString), CStr(itm.Year), QStr(itm.Genre), CStr(itm.Rating), CStr(bitrate), _
  115.       QStr(itm.Path), QStr(itm.MediaLabel)), ",")
  116.     Progress.Value = i+1
  117.     if Progress.Terminate then
  118.       Exit For
  119.     end if
  120.   next
  121.  
  122.   ' Close the output file and finish
  123.   fout.Close
  124.  
  125.   ' Was it successfull?
  126.   Dim ok
  127.   if Progress.Terminate then
  128.     ok = False
  129.   else
  130.     ok = True
  131.   end if
  132.  
  133.   ' hide progress
  134.   Set Progress = Nothing
  135.  
  136.   Call FinishExport( ok)
  137. End Sub
  138.  
  139.  
  140. Sub ExportHTML 
  141.   ' initialize export 
  142.   Call InitExport( ".htm", "HTML (*.htm)|*.htm|All files (*.*)|*.*", _ 
  143.   "LastExportHTMLDir") 
  144.   if fullfile="" then 
  145.   Exit Sub 
  146.   end if 
  147.  
  148.   ' Create the output file 
  149.   Dim fout 
  150.   Set fout = fso.CreateTextFile( fullfile, True) 
  151.  
  152.   ' Write header line 
  153.   fout.WriteLine "<html>" 
  154.   fout.WriteLine "<head><title>MediaMonkey Track List</title>" 
  155.  
  156.   ' Code to format the document 
  157.   fout.WriteLine "<STYLE TYPE=text/css>" 
  158.   fout.WriteLine "body{font-family:'Verdana',sans-serif; background-color:#FFFFFF; font-size:9pt; color:#000000;}" 
  159.   fout.WriteLine "H1{font-family:'Verdana',sans-serif; font-size:13pt; font-weight:bold; color:#AAAAAA; text-aligh:left}" 
  160.   fout.WriteLine "P{font-family:'Verdana',sans-serif; font-size:9pt; color:#000000;}" 
  161.   fout.WriteLine "TH{font-family:'Verdana',sans-serif; font-size:10pt; font-weight:bold; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:3px;}" 
  162.   fout.WriteLine "TD{font-family:'Verdana',sans-serif; font-size:9pt; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}" 
  163.   fout.Writeline "TD.dark{background-color:#EEEEEE}" 
  164.   fout.WriteLine "</STYLE>" 
  165.  
  166.   fout.WriteLine "</head><body>" 
  167.   fout.WriteLine "<a href='http://www.mediamonkey.com'><H1>MediaMonkey Track List</H1></a>" 
  168.  
  169.   ' Headers of table 
  170.   fout.WriteLine "<TABLE CELLPADDING=4 CELLSPACING=0>" 
  171.   fout.WriteLine "<tr>" 
  172.   fout.WriteLine " <th ID=dark>#</th>" 
  173.   fout.WriteLine " <th>Artist</th>" 
  174.   fout.WriteLine " <th ID=dark>Title</th>" 
  175.   fout.WriteLine " <th>Time</th>" 
  176.   fout.WriteLine " <th ID=dark>Album</th>" 
  177.   fout.WriteLine " <th>Track#</th>" 
  178.   fout.WriteLine " <th ID=dark>Year</th>" 
  179.   fout.WriteLine " <th>Genre</th>" 
  180.   fout.WriteLine " <th ID=dark>Rating</th>" 
  181.   fout.WriteLine " <th>Bitrate</th>" 
  182.   fout.WriteLine " <th ID=dark>Media</th>" 
  183.   fout.WriteLine "</tr>" 
  184.  
  185.   ' Use progress to notify user about the current action 
  186.   Dim Progress 
  187.   Set Progress = SDB.Progress 
  188.   Progress.Text = "Exporting to a HTML file..." 
  189.  
  190.   ' Iterate through the list and export all songs 
  191.   Progress.MaxValue = list.count 
  192.   Dim i, itm 
  193.   for i=0 to list.count-1 
  194.     Set itm = list.Item(i) 
  195.     Dim bitrate 
  196.     bitrate = itm.bitrate 
  197.     if bitrate>0 then 
  198.       bitrate = CStr(Round( bitrate/1000)) 
  199.     else 
  200.       bitrate = " " 
  201.     end if 
  202.     Dim year 
  203.     year = itm.year 
  204.     if year<=0 then 
  205.       year = " " 
  206.     else 
  207.       year = CStr( year) 
  208.     end if 
  209.  
  210.     ' Add space to empty fields, so table is displayed correctly (Cell borders do not show up for empty cells) 
  211.     Dim artistname 
  212.     artistname = itm.ArtistName 
  213.     if artistname="" then 
  214.       artistname = " " 
  215.     end if 
  216.  
  217.     Dim songtitle 
  218.     songtitle = itm.title 
  219.     if songtitle="" then 
  220.       songtitle = " " 
  221.     end if 
  222.  
  223.     Dim albumname 
  224.     albumname = itm.AlbumName 
  225.     if albumname="" then 
  226.       albumname = " " 
  227.     end if 
  228.  
  229.     Dim songlength 
  230.     songlength = itm.SongLengthString 
  231.     if songlength="" then 
  232.       songlength = " " 
  233.     end if 
  234.  
  235.     Dim songgenre 
  236.     songgenre = itm.Genre 
  237.     if songgenre="" then 
  238.       songgenre = " " 
  239.     end if 
  240.  
  241.     Dim trackorder 
  242.     trackorder = itm.TrackOrder 
  243.     if trackorder="" then 
  244.       trackorder = " " 
  245.     elseif trackorder = "0" then 
  246.       trackorder = " " 
  247.     end if 
  248.  
  249.     ' These are added to get some decent display, all the others haven't, this script is just to demonstrate all the available options 
  250.  
  251.     Dim rating 
  252.     rating = itm.Rating 
  253.     if rating ="" then 
  254.       rating = " " 
  255.     elseif rating = "-1" then 
  256.       rating = " " 
  257.     end if 
  258.  
  259.     Dim medialabel
  260.     medialabel = itm.MediaLabel
  261.     if medialabel="" then 
  262.       medialabel = " " 
  263.     end if
  264.  
  265.     ' Body of the table 
  266.     fout.WriteLine "<tr><td align=right class=dark>"&i+1&"</TD><TD>"&artistname&"</td><td class=dark>"&songtitle _ 
  267.     &"</td><td align=right>"&songlength&"</td><td class=dark>"&albumname _ 
  268.     &"</td><td align=right>"&trackorder&"</td><td align=right class=dark>"&Year _ 
  269.     &"</td><td>"&songgenre&"</td><td align=right class=Dark>"&rating&"</td><td align=right>"&bitrate _ 
  270.     &"</td><td align=right class=Dark>"&medialabel&"</td></tr>" 
  271.     Progress.Value = i+1 
  272.     if Progress.Terminate then 
  273.       Exit For 
  274.     end if 
  275.   next 
  276.  
  277.   ' Write some code to finish html document 
  278.   fout.WriteLine "</table><p/><table width=100%><tr>"
  279.   fout.WriteLine "<td style='border-bottom-width:0px'><B>Total Tracks: </B>"&i&"</td> <td align=Right style='border-bottom-width:0px'>Generated by <a href='http://www.mediamonkey.com'>MediaMonkey</a></td>"
  280.   fout.WriteLine "</tr></table></body></html>"
  281.  
  282.   ' Close the output file and finish 
  283.   fout.Close 
  284.  
  285.   ' Was it successfull? 
  286.   Dim ok 
  287.   if Progress.Terminate then 
  288.     ok = False 
  289.   else 
  290.     ok = True 
  291.   end if 
  292.  
  293.   ' hide progress 
  294.   Set Progress = Nothing 
  295.  
  296.   FinishExport( ok) 
  297. End Sub 
  298.  
  299.  
  300. Sub ExportXLS
  301.   ' initialize export
  302.   Call InitExport( ".xls", "Excel sheet (*.xls)|*.xls|All files (*.*)|*.*", _
  303.         "LastExportExcelDir")
  304.   if fullfile="" then
  305.     Exit Sub
  306.   end if
  307.  
  308.   if fso.FileExists( fullfile) then
  309.     fso.DeleteFile( fullfile)
  310.   end if
  311.  
  312.   On Error Resume Next
  313.  
  314.   ' Connect to Excel
  315.   Dim Excel, WB, WS
  316.   Set Excel = CreateObject("Excel.application")
  317.  
  318.   If Err.Number<>0 then
  319.     MsgBox "Microsoft Excel could not be found, please install it and try again."
  320.     Err.Clear
  321.     Exit Sub
  322.   End If
  323.   On Error GoTo 0
  324.  
  325.   ' Create a new workbook and get its worksheet
  326.   Set WB = Excel.WorkBooks.Add
  327.   Set WS = WB.Sheets(1)
  328.  
  329.   ' Use progress to notify user about the current action
  330.   Dim Progress
  331.   Set Progress = SDB.Progress
  332.   Progress.Text = "Exporting to an Excel file..."
  333.  
  334.   ' Create a header
  335.   WS.Cells(1,1).Value = "Artist"
  336.   WS.Cells(1,2).Value = "Album"
  337.   WS.Cells(1,3).Value = "Title"
  338.   WS.Cells(1,4).Value = "Length"
  339.   WS.Cells(1,5).Value = "Year"
  340.   WS.Cells(1,6).Value = "Genre"
  341.   WS.Cells(1,7).Value = "Bitrate"
  342.   WS.Cells(1,8).Value = "Media"
  343.  
  344.   WS.Rows("1:1").Font.Bold = True
  345.  
  346.   ' Iterate through the list and export all songs
  347.   Progress.MaxValue = list.count
  348.   Dim i, itm
  349.   for i=0 to list.count-1
  350.     Set itm = list.Item(i)
  351.     Dim bitrate
  352.     bitrate = itm.bitrate
  353.     if bitrate>0 then
  354.       bitrate = CStr(Round( bitrate/1000))
  355.     else
  356.       bitrate = ""
  357.     end if
  358.     Dim year
  359.     year = itm.year
  360.     if year<=0 then
  361.       year = ""
  362.     else
  363.       year = CStr( year)
  364.     end if
  365.  
  366.     WS.Cells(i+2,1).Value = itm.ArtistName
  367.     WS.Cells(i+2,2).Value = itm.AlbumName
  368.     WS.Cells(i+2,3).Value = itm.title
  369.     WS.Cells(i+2,4).Value = itm.SongLengthString
  370.     WS.Cells(i+2,5).Value = year
  371.     WS.Cells(i+2,6).Value = itm.Genre
  372.     WS.Cells(i+2,7).Value = bitrate
  373.     WS.Cells(i+2,8).Value = itm.MediaLabel
  374.  
  375.     Progress.Value = i+1
  376.     if Progress.Terminate then
  377.       Exit For
  378.     end if
  379.   next
  380.  
  381.   ' Was it successfull?
  382.   Dim ok
  383.   if Progress.Terminate then
  384.     ok = False
  385.   else
  386.     ok = True
  387.     WB.SaveAs fullfile
  388.   end if
  389.  
  390.   WB.Close false
  391.  
  392.   ' hide progress
  393.   Set Progress = Nothing
  394.  
  395.   FinishExport( ok)
  396. End Sub
  397.  
  398.  ' escape XML string
  399. Function MapXML( srcstring)
  400.   srcstring = Replace( srcstring, "&", "&")
  401.   srcstring = Replace( srcstring, "<", "<")
  402.   srcstring = Replace( srcstring, ">", ">")
  403.   Dim i
  404.   i=1
  405.   While i<=Len(srcstring)
  406.     If (Asc(Mid(srcstring, i, 1))>127) Then
  407.       srcstring = Mid( srcstring, 1, i-1)+"&#"+CStr( Asc( Mid( srcstring, i, 1)))+";"+Mid( srcstring, i+1, Len(srcstring))
  408.     End If
  409.     i=i+1
  410.   WEnd
  411.   MapXML = srcstring
  412. End Function
  413.  
  414. Sub ExportXML
  415.   ' initialize export
  416.   Call InitExport (".xml", "XML (*.xml)|*.xml|All files (*.*)|*.*", _
  417.       "LastExportXMLDir")
  418.   if fullfile="" then
  419.     Exit Sub
  420.   end if
  421.  
  422.   ' Create the output file
  423.   Dim fout
  424.   Set fout = fso.CreateTextFile( fullfile, True)
  425.  
  426.   ' Use progress to notify user about the current action
  427.   Dim Progress
  428.   Set Progress = SDB.Progress
  429.   Dim ProgressString
  430.   ProgressString = "Exporting to an XML file... "
  431.  
  432.   Dim i
  433.   Dim Artists, Artist
  434.   Set Artists = list.Artists
  435.   Dim Albums, Album
  436.   Set Albums = list.Albums
  437.  
  438.   fout.WriteLine "<?xml version='1.0'?>"
  439.   fout.WriteLine "<MusicDatabase>"
  440.  
  441.   Progress.MaxValue = list.count + Artists.Count + Albums.Count
  442.  
  443.   Progress.Text = ProgressString & " (artists)"
  444.   fout.WriteLine "  <Artists>"
  445.   for i=0 to Artists.count-1
  446.     Set Artist = Artists.Item(i)
  447.     fout.WriteLine "    <Artist id=""Artist_"&Artist.id&""">"
  448.     fout.WriteLine "       <Name>" & MapXML(Artist.Name) & "</Name>"
  449.     fout.WriteLine "    </Artist>"
  450.     Progress.Increase
  451.     if Progress.Terminate then
  452.       Exit For
  453.     end if
  454.   next
  455.   fout.WriteLine "  </Artists>"
  456.  
  457.   Progress.Text = ProgressString & " (albums)"
  458.   fout.WriteLine "  <Albums>"
  459.   for i=0 to Albums.count-1
  460.     Set Album = Albums.Item(i)
  461.     fout.WriteLine "    <Album id=""Album_"&Album.id&""">"
  462.     fout.WriteLine "       <PerformingArtist id="""& Album.Artist.id & """>" & MapXML(Album.Artist.Name) & "</PerformingArtist>"
  463.     fout.WriteLine "       <Name>" & MapXML(Album.Name) & "</Name>"
  464.     fout.WriteLine "    </Album>"
  465.     Progress.Increase
  466.     if Progress.Terminate then
  467.       Exit For
  468.     end if
  469.   next
  470.   fout.WriteLine "  </Albums>"
  471.  
  472.   ' Iterate through the list and export all songs
  473.   Progress.Text = ProgressString & " (songs)"
  474.   fout.WriteLine "  <Songs>"
  475.   Progress.MaxValue = list.count
  476.   Dim Song, Media
  477.   for i=0 to list.count-1
  478.     Set Song = list.Item(i)
  479.     fout.WriteLine "    <Song id=""Song_"&Song.id&""">"
  480.     fout.WriteLine "       <Title>" & MapXML(Song.Title) & "</Title>"
  481.     fout.WriteLine "       <PerformingArtist id=""Artist_"& Song.Artist.id & """>" & MapXML(Song.ArtistName) & "</PerformingArtist>"
  482.     fout.WriteLine "       <ContainedInAlbum id=""Album_"& Song.Album.id & """>" & MapXML(Song.AlbumName) & "</ContainedInAlbum>"
  483.     fout.WriteLine "       <SongLength ms="""& Song.SongLength &""">" & MapXML(Song.SongLengthString) & "</SongLength>"
  484.     if Song.Year>0 then
  485.       fout.WriteLine "       <Year value="""& MapXML(Song.Year) &"""/>"
  486.     end if
  487.     if Song.Genre<>"" then
  488.       fout.WriteLine "       <Genre>"& MapXML(Song.Genre) &"</Genre>"
  489.     end if
  490.     fout.WriteLine "       <Bitrate>"& MapXML(Song.Bitrate) &"</Bitrate>"
  491.  
  492.     Set Media = Song.Media
  493.     fout.WriteLine "       <Location>"
  494.     fout.WriteLine "         <Media id=""Media_"&Media.id&""" sn=""" & _
  495.        Media.SerialNumber & """>"& MapXML(Media.MediaLabel) &"</Media>"
  496.     fout.WriteLine "         <Path>"& MapXML(Song.Path) &"</Path>"
  497.     fout.WriteLine "       </Location>"
  498.  
  499.     fout.WriteLine "    </Song>"
  500.     Progress.Increase
  501.     if Progress.Terminate then
  502.       Exit For
  503.     end if
  504.   next
  505.   fout.WriteLine "  </Songs>"
  506.  
  507.   fout.WriteLine "</MusicDatabase>"
  508.  
  509.   ' Close the output file and finish
  510.   fout.Close
  511.  
  512.   ' Was it successfull?
  513.   Dim ok
  514.   if Progress.Terminate then
  515.     ok = False
  516.   else
  517.     ok = True
  518.   end if
  519.  
  520.   ' hide progress
  521.   Set Progress = Nothing
  522.  
  523.   Call FinishExport( ok)
  524. End Sub
  525.  
  526.